{*******************************************************}
{       Borland Delphi Visual Component Library         }
{       Support classes for hosting servers in IDE      }
{                                                       }
{       $Revision: 1.1 $                            }
{       Copyright (c) 1999 Inprise Corporation          }
{*******************************************************}
unit EIColeserver;

{$R-}

interface

uses Windows, Messages, ActiveX, SysUtils, Classes, ComObj,OleServer;

type
  CEICOleServer = class(TOLEServer)
  protected

    function GetIDsOfEventNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; virtual; abstract;

  public
    constructor Create(AOwner: TComponent); override;
    property  ServerData;
  end;

  CEICServerEventDispatch = class(TObject, IUnknown, IDispatch)
  private
    FServer: CEICOleServer;
    InternalRefCount : Integer;
  protected
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { IDispatch }
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
    property Server: CEICOleServer read FServer;
    function ServerDisconnect :Boolean;
  public
    constructor Create(Server: CEICOleServer);
  end;



implementation

uses OleConst;

{ CEICServerEventDispatch }
constructor CEICServerEventDispatch.Create(Server: CEICOleServer);
begin
  FServer := Server;
  InternalRefCount := 1;
end;

{ CEICServerEventDispatch.IUnknown }
function CEICServerEventDispatch.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
  begin
    Result := S_OK;
    Exit;
  end;
  if IsEqualIID(IID, FServer.ServerData^.EventIID) then
  begin
    GetInterface(IDispatch, Obj);
    Result := S_OK;
    Exit;
  end;
  Result := E_NOINTERFACE;
end;

function CEICServerEventDispatch._AddRef: Integer;
begin
  if FServer <> nil then FServer._AddRef;
  InternalRefCount := InternalRefCount + 1;
  Result := InternalRefCount;
end;

function CEICServerEventDispatch._Release: Integer;
begin
  if FServer <> nil then FServer._Release;
  InternalRefCount := InternalRefCount -1;
  Result := InternalRefCount;
end;

{ CEICServerEventDispatch.IDispatch }
function CEICServerEventDispatch.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Count := 0;
  Result:= S_OK;
end;
             
function CEICServerEventDispatch.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
  Pointer(TypeInfo) := nil;
  Result := E_NOTIMPL;
end;

function CEICServerEventDispatch.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  if FServer = nil then
    Result := E_NOTIMPL
  else
    Result := FServer.GetIDsOfEventNames(IID,Names,NameCount, LocaleID, DispIDs);
end;

function CEICServerEventDispatch.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params;
  VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
  ParamCount, I: integer;
  VarArray : TVariantArray;
begin
  // Get parameter count
  ParamCount := TDispParams(Params).cArgs;
  // Set our array to appropriate length
  SetLength(VarArray, ParamCount);
  // Copy over data
  for I := Low(VarArray) to High(VarArray) do
    VarArray[High(VarArray)-I] := OleVariant(TDispParams(Params).rgvarg^[I]);
  // Invoke Server proxy class
  if FServer <> nil then FServer.InvokeEvent(DispID, VarArray);
  // Clean array
  SetLength(VarArray, 0);
  // Pascal Events return 'void' - so assume success!
  Result := S_OK;
end;

function CEICServerEventDispatch.ServerDisconnect : Boolean;
begin
  FServer := nil;
  if FServer <> nil then
    Result := false
  else Result := true;
end;

{CEICOleServer}
constructor CEICOleServer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // Create Event Dispatch Handler
  EventDispatch := TServerEventDispatch(CEICServerEventDispatch.Create(Self));
end;

end.
